home *** CD-ROM | disk | FTP | other *** search
/ Software Vault: The Gold Collection / Software Vault - The Gold Collection (American Databankers) (1993).ISO / cdr52 / tbar.zip / FTDIR.PRG < prev    next >
Text File  |  1993-04-01  |  7KB  |  152 lines
  1. /*┌──────────────────────────────────────────────────────────────────────┐
  2.  ▌│ Program Name: FTDIR.PRG          Language: Clipper 5.0               │
  3.  ▌│ Date Created:                      Author: Kevin S Gallagher         │
  4.  ▌│ Show a single highlight bar in a TBrowse,  uses NANFOR.LIB           │
  5.  ▌└──────────────────────────────────────────────────────────────────────┘
  6.  ▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀            */
  7. #include 'include1.ch'
  8. function main
  9.     local nVal:= FT_DIR2DB( "*.*","testksg","ksgntx" )
  10.     local oldc:= setcursor( 0 )
  11.     set(_SET_SCOREBOARD, .f.)
  12.     if nVal = 0
  13.         TBView()
  14.         ferase("testksg.dbf")                // cleanup
  15.         ferase("ksgntx.ntx")                 // unwanted files
  16.     endif
  17.     setcursor( oldc )
  18. return nil
  19.  
  20. /*
  21. ╔════════════════════════════════════════════════════════════════════════════╗
  22. ║ This function uses TBrowse to view a database that was created with        ║
  23. ║ FT_DIR2DB()  -- (See NANFORUM's  NG HelpDatabase)                          ║
  24. ║                                                                            ║
  25. ║ When TBrowse shows data (.dbf, textfiles, arrays etc.), the current cell   ║
  26. ║ is highlighted with a specified color from "colorSpec" or SETCOLOR()       ║
  27. ║ Providing "autoLite" is set to logical "true". By using "colorRect()"      ║
  28. ║ method a rectangular area may be painted, thus allowing all the cells on   ║
  29. ║ the current TBrowse row to be highlighted, instead of just one cell.       ║
  30. ║ Note that "colorRect" does not paint the column separator character!       ║
  31. ║ One way of painting the separator character is to use a function that      ║
  32. ║ will change the color attributes of a screen region. Since the library     ║
  33. ║ "Nanfor.lib" is Public Domain, and it has just the function needed to get  ║
  34. ║ the job done "FT_SETATTR()" which is written in assemble language, so its  ║
  35. ║ fast!                                                                      ║
  36. ║                                                                            ║
  37. ║ FT_SETATTR( <nTopRow>, <nTopCol>, <nBotRow>, <nBotCol>, nColor )           ║
  38. ║ FT_SETATTR( b:rowPos+4, oTc, b:rowPos+4, oBc-1, 95 )                       ║
  39. ║ <nTopRow> is TBrowse's TopRow --> 1    When TBrowse is first shown..       ║
  40. ║ So that in this example, if we simple pass "b:rowPos" to FT_SETATTR()      ║
  41. ║ the highlight would end up above the TBrowse, and the surrounding box.     ║
  42. ║ Being that FT_SETATTR() uses screen coordinates, not TBrowse coordinates.  ║
  43. ║ So I added the amount of rows, above the TBrowse to get the correct        ║
  44. ║ Browse row, and the same goes for <nBotRow> since it must be informed      ║
  45. ║ that we want the highlight to be the same as <nTopRow>.                    ║
  46. ║                                                                            ║
  47. ║ Ignore <nBotCol>  "oBc-1" the "-1" has nothing to do with our highlight    ║
  48. ║ bar, it is for fixing a small problem, in BoxShad(). I wanted to keep      ║
  49. ║ the screen code out of sight..                                             ║
  50. ╚════════════════════════════════════════════════════════════════════════════╝
  51. */
  52. function TBView
  53.     local oTr:=3,oTc:=4,oBr:=20,oBc:=72,key:= 0, b,c
  54.     local SaveFullScreen()
  55.  
  56.     Panel(.F.)
  57.     BoxShad(oTr,oTc,oBr,oBc,"W/B")
  58.  
  59.     USE testksg NEW
  60.     IF !NETERR()
  61.         DBSETINDEX("ksgntx")
  62.     ELSE
  63.         alert("Network error")
  64.         quit
  65.     ENDIF
  66.     // @ oTr-3,oTc+2 say " TBrowse row "
  67.     b:=TBrowseDB(oTr, oTc, oBr-1, oBc-1)
  68.     b:colorSpec := BCOLOR                        //── include1.ch
  69.     b:headSep   := '═╤═'
  70.     b:colSep    := ' │ '
  71.  
  72.     c:=TBColumnNew('Name', fieldblock('NAME'))
  73.     c:width := 12
  74.     b:AddColumn( c )
  75.     c := TBColumnNew('Size', fieldblock('SIZE'))
  76.     b:AddColumn( c )
  77.     c := TBColumnNew('Date', fieldblock('DATE'))
  78.     b:AddColumn( c )
  79.     c:=TBColumnNew('Time',{||FT_MIL2CIV(STRTRAN(SUBSTR(testksg->TIME,1,5),;
  80.                            ":","";
  81.                            );
  82.                    );
  83.             };
  84.     )
  85.     b:AddColumn( c )
  86.     c := TBColumnNew('Attribute', fieldblock('ATTR'))
  87.     b:AddColumn( c )
  88.  
  89.     BEGIN SEQUENCE
  90.      DO WHILE .T.
  91.         *
  92.         * Paint the top row of the browse with all cells highlighted
  93.         b:colorRect( { b:rowPos, 1, b:rowPos, b:colCount } , { 1 , 1 } )
  94.         STABILIZE b                              //── see include1.ch
  95.         do while .not. b:stabilize()   ;   enddo
  96.         if b:stabilize()
  97.            @ oTr-1,oTc+2 say padr("["+str(b:rowPos,2,0)+"]",4)
  98.            *
  99.            * Paint all cells on current row
  100.            * paint column separator character, using ft_setattr()
  101.            *
  102.            b:colorRect( { b:rowPos, 1, b:rowPos, b:colCount } , { 2 , 2 } )
  103.            FT_SETATTR( b:rowPos+4, oTc, b:rowPos+4, oBc-1, 95 )
  104.            while ((key := inkey(.1)) == 0)
  105.                *
  106.                * Show a message
  107.                *
  108.                RainHead()                  
  109.            enddo
  110.         endif
  111.         do case
  112.             case key == K_ESC          ;   alert("Press F10 to exit")
  113.             case key == K_F1           ;   alert("NO HELP")
  114.             case key == K_UP           ;   b:up()
  115.             case key == K_DOWN         ;   b:down()
  116.             case key == K_PGDN         ;   b:pageDown()
  117.             case key == K_PGUP         ;   b:pageUp()
  118.             case key == K_CTRL_PGDN    ;   b:goBottom()
  119.             case key == K_CTRL_PGUP    ;   b:goTop()
  120.             case key == K_HOME         ;   b:home()
  121.             case key == K_F10          ;   break
  122.             case key == K_END          ;   b:end()
  123.         endcase
  124.     enddo
  125.     END SEQUENCE
  126.     RestFullScreen()
  127.     dbCloseArea()
  128. return nil
  129.  
  130. static function RainHead()                       //── Michael J. Riche
  131.     local TBTline := " Check out the TBrowse highlight-bar "
  132.     local XLEN    := LEN(TBTline)
  133.     local nLen    := XLEN - 1
  134.     local C       := ( (80-XLEN) / 2 )
  135.     local R       := 0
  136.     static Colors := {'G+','BG','R+','B','G+','RB','R+','BG+','R','B+','G','RB+'}
  137.     static w      := 0
  138.     static nCnt   := 0
  139.     SetPos(R,C ) ; ;
  140.     DispOut( TBTline, "W+/BG")
  141.     SetPos(R,C + nCnt ) ; ;
  142.     DispOut( substr(TBTline, nCnt + 1, 1) , colors[++w % 12 + 1] + '/N')
  143.     IF w > 11
  144.         w := 0
  145.     ENDIF
  146.     IF (++nCnt > nLen)
  147.         nCnt := 0
  148.     ENDIF
  149. return (nil)
  150.  
  151.  
  152.